home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / gnu / dejagnu.lha / dejagnu-1.0.1 / tcl / tests / info.test < prev    next >
Text File  |  1993-02-14  |  14KB  |  493 lines
  1. # Commands covered:  info
  2. #
  3. # This file contains a collection of tests for one or more of the Tcl
  4. # built-in commands.  Sourcing this file into Tcl runs the tests and
  5. # generates output for errors.  No output means no errors were found.
  6. #
  7. # Copyright 1991 Regents of the University of California
  8. # Permission to use, copy, modify, and distribute this
  9. # software and its documentation for any purpose and without
  10. # fee is hereby granted, provided that this copyright notice
  11. # appears in all copies.  The University of California makes no
  12. # representations about the suitability of this software for any
  13. # purpose.  It is provided "as is" without express or implied
  14. # warranty.
  15. #
  16. # $Header: /rel/cvsfiles/devo/tcl/tests/info.test,v 1.2 1992/12/23 15:34:14 zoo Exp $ (Berkeley)
  17.  
  18. if {[string compare test [info procs test]] == 1} then {source defs}
  19.  
  20. test info-1.1 {info args option} {
  21.     proc t1 {a bbb c} {return foo}
  22.     info args t1
  23. } {a bbb c}
  24. test info-1.2 {info args option} {
  25.     proc t1 {{a default1} {bbb default2} {c default3} args} {return foo}
  26.     info a t1
  27. } {a bbb c args}
  28. test info-1.3 {info args option} {
  29.     proc t1 "" {return foo}
  30.     info args t1
  31. } {}
  32. test info-1.4 {info args option} {
  33.     catch {rename t1 {}}
  34.     list [catch {info args t1} msg] $msg
  35. } {1 {"t1" isn't a procedure}}
  36. test info-1.5 {info args option} {
  37.     list [catch {info args set} msg] $msg
  38. } {1 {"set" isn't a procedure}}
  39.  
  40. test info-2.1 {info body option} {
  41.     proc t1 {} {body of t1}
  42.     info body t1
  43. } {body of t1}
  44. test info-2.2 {info body option} {
  45.     list [catch {info body set} msg] $msg
  46. } {1 {"set" isn't a procedure}}
  47. test info-2.3 {info body option} {
  48.     list [catch {info args set 1} msg] $msg
  49. } {1 {wrong # args: should be "info args procname"}}
  50.  
  51. test info-3.1 {info cmdcount option} {
  52.     set x [info cmdcount]
  53.     set y 12345
  54.     set z [info cm]
  55.     expr $z-$x
  56. } 3
  57. test info-3.2 {info body option} {
  58.     list [catch {info cmdcount 1} msg] $msg
  59. } {1 {wrong # args: should be "info cmdcount"}}
  60.  
  61. test info-4.1 {info commands option} {
  62.     proc t1 {} {}
  63.     proc t2 {} {}
  64.     set x " [info commands] "
  65.     list [string match {* t1 *} $x] [string match {* t2 *} $x] \
  66.             [string match {* set *} $x] [string match {* list *} $x]
  67. } {1 1 1 1}
  68. test info-4.2 {info commands option} {
  69.     proc t1 {} {}
  70.     rename t1 {}
  71.     set x [info comm]
  72.     string match {* t1 *} $x
  73. } 0
  74. test info-4.3 {info commands option} {
  75.     proc _t1_ {} {}
  76.     proc _t2_ {} {}
  77.     info commands _t1_
  78. } _t1_
  79. test info-4.4 {info commands option} {
  80.     proc _t1_ {} {}
  81.     proc _t2_ {} {}
  82.     lsort [info commands _t*]
  83. } {_t1_ _t2_}
  84. catch {rename _t1_ {}}
  85. catch {rename _t2_ {}}
  86. test info-4.5 {info commands option} {
  87.     list [catch {info commands a b} msg] $msg
  88. } {1 {wrong # args: should be "info commands [pattern]"}}
  89.  
  90. test info-5.1 {info complete option} {
  91.     info complete ""
  92. } 1
  93. test info-5.2 {info complete option} {
  94.     info complete "  \n"
  95. } 1
  96. test info-5.3 {info complete option} {
  97.     info complete "abc def"
  98. } 1
  99. test info-5.4 {info complete option} {
  100.     info complete "a b c d e f \t\n"
  101. } 1
  102. test info-5.5 {info complete option} {
  103.     info complete {a b c"d}
  104. } 1
  105. test info-5.6 {info complete option} {
  106.     info complete {a b "c d" e}
  107. } 1
  108. test info-5.7 {info complete option} {
  109.     info complete {a b "c d"}
  110. } 1
  111. test info-5.8 {info complete option} {
  112.     info complete {a b "c d"}
  113. } 1
  114. test info-5.9 {info complete option} {
  115.     info complete {a b "c d}
  116. } 0
  117. test info-5.10 {info complete option} {
  118.     info complete {a b "}
  119. } 0
  120. test info-5.11 {info complete option} {
  121.     info complete {a b "cd"xyz}
  122. } 1
  123. test info-5.12 {info complete option} {
  124.     info complete {a b "c $d() d"}
  125. } 1
  126. test info-5.13 {info complete option} {
  127.     info complete {a b "c $dd("}
  128. } 0
  129. test info-5.14 {info complete option} {
  130.     info complete {a b "c \"}
  131. } 0
  132. test info-5.15 {info complete option} {
  133.     info complete {a b "c [d e f]"}
  134. } 1
  135. test info-5.16 {info complete option} {
  136.     info complete {a b "c [d e f] g"}
  137. } 1
  138. test info-5.17 {info complete option} {
  139.     info complete {a b "c [d e f"}
  140. } 0
  141. test info-5.18 {info complete option} {
  142.     info complete {a {b c d} e}
  143. } 1
  144. test info-5.19 {info complete option} {
  145.     info complete {a {b c d}}
  146. } 1
  147. test info-5.20 {info complete option} {
  148.     info complete "a b\{c d"
  149. } 1
  150. test info-5.21 {info complete option} {
  151.     info complete "a b \{c"
  152. } 0
  153. test info-5.22 {info complete option} {
  154.     info complete "a b \{c{ }"
  155. } 0
  156. test info-5.23 {info complete option} {
  157.     info complete "a b {c d e}xxx"
  158. } 1
  159. test info-5.24 {info complete option} {
  160.     info complete "a b {c \\\{d e}xxx"
  161. } 1
  162. test info-5.25 {info complete option} {
  163.     info complete {a b [ab cd ef]}
  164. } 1
  165. test info-5.26 {info complete option} {
  166.     info complete {a b x[ab][cd][ef] gh}
  167. } 1
  168. test info-5.27 {info complete option} {
  169.     info complete {a b x[ab][cd[ef] gh}
  170. } 0
  171. test info-5.28 {info complete option} {
  172.     info complete {a b x[ gh}
  173. } 0
  174. test info-5.29 {info complete option} {
  175.     info complete {[]]]}
  176. } 1
  177. test info-5.30 {info complete option} {
  178.     info complete {abc x$yyy}
  179. } 1
  180. test info-5.31 {info complete option} {
  181.     info complete "abc x\${abc\[\\d} xyz"
  182. } 1
  183. test info-5.32 {info complete option} {
  184.     info complete "abc x\$\{ xyz"
  185. } 0
  186. test info-5.33 {info complete option} {
  187.     info complete {word $a(xyz)}
  188. } 1
  189. test info-5.34 {info complete option} {
  190.     info complete {word $a(}
  191. } 0
  192. test info-5.35 {info complete option} {
  193.     info complete "set a \\\n"
  194. } 0
  195. test info-5.36 {info complete option} {
  196.     info complete "set a \\n "
  197. } 1
  198. test info-5.37 {info complete option} {
  199.     info complete "set a \\"
  200. } 1
  201.  
  202. test info-6.1 {info default option} {
  203.     proc t1 {a b {c d} {e "long default value"}} {}
  204.     info default t1 a value
  205. } 0
  206. test info-6.2 {info default option} {
  207.     proc t1 {a b {c d} {e "long default value"}} {}
  208.     set value 12345
  209.     info d t1 a value
  210.     set value
  211. } {}
  212. test info-6.3 {info default option} {
  213.     proc t1 {a b {c d} {e "long default value"}} {}
  214.     info default t1 c value
  215. } 1
  216. test info-6.4 {info default option} {
  217.     proc t1 {a b {c d} {e "long default value"}} {}
  218.     set value 12345
  219.     info default t1 c value
  220.     set value
  221. } d
  222. test info-6.5 {info default option} {
  223.     proc t1 {a b {c d} {e "long default value"}} {}
  224.     set value 12345
  225.     set x [info default t1 e value]
  226.     list $x $value
  227. } {1 {long default value}}
  228. test info-6.6 {info default option} {
  229.     list [catch {info default a b} msg] $msg
  230. } {1 {wrong # args: should be "info default procname arg varname"}}
  231. test info-6.7 {info default option} {
  232.     list [catch {info default _nonexistent_ a b} msg] $msg
  233. } {1 {"_nonexistent_" isn't a procedure}}
  234. test info-6.8 {info default option} {
  235.     proc t1 {a b} {}
  236.     list [catch {info default t1 x value} msg] $msg
  237. } {1 {procedure "t1" doesn't have an argument "x"}}
  238. test info-6.9 {info default option} {
  239.     catch {unset a}
  240.     set a(0) 88
  241.     proc t1 {a b} {}
  242.     list [catch {info default t1 a a} msg] $msg
  243. } {1 {couldn't store default value in variable "a"}}
  244. test info-6.10 {info default option} {
  245.     catch {unset a}
  246.     set a(0) 88
  247.     proc t1 {{a 18} b} {}
  248.     list [catch {info default t1 a a} msg] $msg
  249. } {1 {couldn't store default value in variable "a"}}
  250. catch {unset a}
  251.  
  252. test info-7.1 {info exists option} {
  253.     set value foo
  254.     info exists value
  255. } 1
  256. catch {unset _nonexistent_}
  257. test info-7.2 {info exists option} {
  258.     info exists _nonexistent_
  259. } 0
  260. test info-7.3 {info exists option} {
  261.     proc t1 {x} {return [info exists x]}
  262.     t1 2
  263. } 1
  264. test info-7.4 {info exists option} {
  265.     proc t1 {x} {
  266.         global _nonexistent_
  267.         return [info exists _nonexistent_]
  268.     }
  269.     t1 2
  270. } 0
  271. test info-7.5 {info exists option} {
  272.     proc t1 {x} {
  273.         set y 47
  274.         return [info exists y]
  275.     }
  276.     t1 2
  277. } 1
  278. test info-7.6 {info exists option} {
  279.     proc t1 {x} {return [info exists value]}
  280.     t1 2
  281. } 0
  282. test info-7.7 {info exists option} {
  283.     catch {unset x}
  284.     set x(2) 44
  285.     list [info exists x] [info exists x(1)] [info exists x(2)]
  286. } {1 0 1}
  287. catch {unset x}
  288. test info-7.8 {info exists option} {
  289.     list [catch {info exists} msg] $msg
  290. } {1 {wrong # args: should be "info exists varName"}}
  291. test info-7.9 {info exists option} {
  292.     list [catch {info exists 1 2} msg] $msg
  293. } {1 {wrong # args: should be "info exists varName"}}
  294.  
  295. test info-8.1 {info globals option} {
  296.     set x 1
  297.     set y 2
  298.     set value 23
  299.     set a " [info globals] "
  300.     list [string match {* x *} $a] [string match {* y *} $a] \
  301.             [string match {* value *} $a] [string match {* _foobar_ *} $a]
  302. } {1 1 1 0}
  303. test info-8.2 {info globals option} {
  304.     set _xxx1 1
  305.     set _xxx2 2
  306.     lsort [info g _xxx*]
  307. } {_xxx1 _xxx2}
  308. test info-8.3 {info globals option} {
  309.     list [catch {info globals 1 2} msg] $msg
  310. } {1 {wrong # args: should be "info globals [pattern]"}}
  311.  
  312. test info-9.1 {info level option} {
  313.     info level
  314. } 0
  315. test info-9.2 {info level option} {
  316.     proc t1 {a b} {
  317.         set x [info le]
  318.         set y [info level 1]
  319.         list $x $y
  320.     }
  321.     t1 146 testString
  322. } {1 {t1 146 testString}}
  323. test info-9.3 {info level option} {
  324.     proc t1 {a b} {
  325.         t2 [expr $a*2] $b
  326.     }
  327.     proc t2 {x y} {
  328.         list [info level] [info level 1] [info level 2] [info level -1] \
  329.                 [info level 0]
  330.     }
  331.     t1 146 {a {b c} {{{c}}}}
  332. } {2 {t1 146 {a {b c} {{{c}}}}} {t2 292 {a {b c} {{{c}}}}} {t1 146 {a {b c} {{{c}}}}} {t2 292 {a {b c} {{{c}}}}}}
  333. test info-9.4 {info level option} {
  334.     proc t1 {} {
  335.         set x [info level]
  336.         set y [info level 1]
  337.         list $x $y
  338.     }
  339.     t1
  340. } {1 t1}
  341. test info-9.5 {info level option} {
  342.     list [catch {info level 1 2} msg] $msg
  343. } {1 {wrong # args: should be "info level [number]"}}
  344. test info-9.6 {info level option} {
  345.     list [catch {info level 123a} msg] $msg
  346. } {1 {expected integer but got "123a"}}
  347. test info-9.7 {info level option} {
  348.     list [catch {info level 0} msg] $msg
  349. } {1 {bad level "0"}}
  350. test info-9.8 {info level option} {
  351.     proc t1 {} {info level -1}
  352.     list [catch {t1} msg] $msg
  353. } {1 {bad level "-1"}}
  354. test info-9.9 {info level option} {
  355.     proc t1 {x} {info level $x}
  356.     list [catch {t1 -3} msg] $msg
  357. } {1 {bad level "-3"}}
  358.  
  359. test info-10.1 {info library option} {
  360.     list [catch {info library x} msg] $msg
  361. } {1 {wrong # args: should be "info library"}}
  362. # The following check can only be done at Berkeley, where the exact
  363. # location of the library is known.
  364.  
  365. if $atBerkeley {
  366.     test info-10.2 {info library option} {
  367.     info li
  368.     } /users/ouster/tcl/library
  369.     test info-10.3 {info library option} {
  370.     set env(TCL_LIBRARY) test_value
  371.     set result [info library]
  372.     unset env(TCL_LIBRARY)
  373.     list $result [info library]
  374.     } {test_value /users/ouster/tcl/library}
  375. }
  376.  
  377. test info-11.1 {info locals option} {
  378.     set a 22
  379.     proc t1 {x y} {
  380.         set b 13
  381.         set c testing
  382.         global a
  383.         return [info locals]
  384.     }
  385.     lsort [t1 23 24]
  386. } {b c x y}
  387. test info-11.2 {info locals option} {
  388.     proc t1 {x y} {
  389.         set xx1 2
  390.         set xx2 3
  391.         set y 4
  392.         return [info lo x*]
  393.     }
  394.     lsort [t1 2 3]
  395. } {x xx1 xx2}
  396. test info-11.3 {info locals option} {
  397.     list [catch {info locals 1 2} msg] $msg
  398. } {1 {wrong # args: should be "info locals [pattern]"}}
  399. test info-11.4 {info locals option} {
  400.     info locals
  401. } {}
  402. test info-11.5 {info locals option} {
  403.     proc t1 {} {return [info locals]}
  404.     t1
  405. } {}
  406.  
  407. test info-12.1 {info procs option} {
  408.     proc t1 {} {}
  409.     proc t2 {} {}
  410.     set x " [info procs] "
  411.     list [string match {* t1 *} $x] [string match {* t2 *} $x] \
  412.             [string match {* _undefined_ *} $x]
  413. } {1 1 0}
  414. test info-12.2 {info procs option} {
  415.     proc _tt1 {} {}
  416.     proc _tt2 {} {}
  417.     lsort [info p _tt*]
  418. } {_tt1 _tt2}
  419. catch {rename _tt1 {}}
  420. catch {rename _tt2 {}}
  421. test info-12.3 {info procs option} {
  422.     list [catch {info procs 2 3} msg] $msg
  423. } {1 {wrong # args: should be "info procs [pattern]"}}
  424.  
  425. test info-13.1 {info script option} {
  426.     list [catch {info script x} msg] $msg
  427. } {1 {wrong # args: should be "info script"}}
  428. test info-13.2 {info script option} {
  429.     file tail [info s]
  430. } info.test
  431. catch {exec rm -f gorp.info}
  432. exec cat > gorp.info << "info script\n"
  433. test info-13.3 {info script option} {
  434.     list [source gorp.info] [file tail [info script]]
  435. } {gorp.info info.test}
  436. test info-13.4 {resetting "info script" after errors} {
  437.     catch {source ~_nobody_/foo}
  438.     file tail [info script]
  439. } {info.test}
  440. test info-13.5 {resetting "info script" after errors} {
  441.     catch {source _nonexistent_}
  442.     file tail [info script]
  443. } {info.test}
  444. exec rm -f gorp.info
  445.  
  446. test info-14.1 {info tclversion option} {
  447.     set x [info tclversion]
  448.     scan $x "%d.%d%c" a b c
  449. } 2
  450. test info-14.2 {info tclversion option} {
  451.     list [catch {info t 2} msg] $msg
  452. } {1 {wrong # args: should be "info tclversion"}}
  453.  
  454. test info-15.1 {info vars option} {
  455.     set a 1
  456.     set b 2
  457.     proc t1 {x y} {
  458.         global a b
  459.         set c 33
  460.         return [info vars]
  461.     }
  462.     lsort [t1 18 19]
  463. } {a b c x y}
  464. test info-15.2 {info vars option} {
  465.     set xxx1 1
  466.     set xxx2 2
  467.     proc t1 {xxa y} {
  468.         global xxx1 xxx2
  469.         set c 33
  470.         return [info vars x*]
  471.     }
  472.     lsort [t1 18 19]
  473. } {xxa xxx1 xxx2}
  474. test info-15.3 {info vars option} {
  475.     lsort [info vars]
  476. } [lsort [info globals]]
  477. test info-15.4 {info vars option} {
  478.     list [catch {info vars a b} msg] $msg
  479. } {1 {wrong # args: should be "info vars [pattern]"}}
  480.  
  481. test info-16.1 {miscellaneous error conditions} {
  482.     list [catch {info} msg] $msg
  483. } {1 {wrong # args: should be "info option ?arg arg ...?"}}
  484. test info-16.2 {miscellaneous error conditions} {
  485.     list [catch {info gorp} msg] $msg
  486. } {1 {bad option "gorp": should be args, body, cmdcount, commands, complete, default, exists, globals, level, library, locals, procs, script, tclversion, or vars}}
  487. test info-16.3 {miscellaneous error conditions} {
  488.     list [catch {info c} msg] $msg
  489. } {1 {bad option "c": should be args, body, cmdcount, commands, complete, default, exists, globals, level, library, locals, procs, script, tclversion, or vars}}
  490. test info-16.4 {miscellaneous error conditions} {
  491.     list [catch {info l} msg] $msg
  492. } {1 {bad option "l": should be args, body, cmdcount, commands, complete, default, exists, globals, level, library, locals, procs, script, tclversion, or vars}}
  493.